home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / lzw4p12.zip / UN_ARC.PAS < prev   
Pascal/Delphi Source File  |  1993-02-21  |  3KB  |  110 lines
  1. (*
  2. **   UN_ARC.PAS     Copyright (C) 1993 by MarshallSoft Computing, Inc.
  3. **
  4. **   This program is used to expand archive created with MK_ARC. For
  5. **   example, to un-archive all the files in 'PAS.ARF', type:
  6. **
  7. **      UN_ARC PAS.ARF
  8. *)
  9.  
  10.  
  11. program UN_ARC;
  12. uses dos, crt, memory, rw_io, hex_io, lzw_errs, LZW4P;
  13.  
  14. type
  15.   String12 = String[12];
  16.   AllocMemoryType = function(Size : Word) : Pointer;
  17.   FreeMemoryType  = function(P : Pointer; Size : Word) : Integer;
  18.  
  19. Var
  20.   InpFileName  : String12;
  21.   OutFileName  : String12;
  22.   MemoryP      : Pointer;
  23.   AllocMemoryP : Pointer;
  24.   FreeMemoryP  : Pointer;
  25.   ReaderP      : Pointer;
  26.   WriterP      : Pointer;
  27.   Size         : Integer;
  28.   Code         : Integer;
  29.   i, x         : Integer;
  30.   DirInfo      : SearchRec;
  31.   Ratio        : Real;
  32.   ReaderCnt    : Real;
  33.   WriterCnt    : Real;
  34.   Count        : Integer;
  35.   AccumCnt     : Integer;
  36. begin
  37.   (* get file specs *)
  38.   if ParamCount <> 1 then
  39.     begin
  40.       writeln('Usage: UN_ARC <arc_file>');
  41.       halt;
  42.     end;
  43.   (* sign on *)
  44.   writeln('UN_ARC 1.0: Type any key to abort...');
  45.   writeln;
  46.   Count := 0;
  47.   (* open input *)
  48.   InpFileName := ParamStr(1);
  49.   Code := ReaderOpen(InpFileName);
  50.   if Code <> 0 then
  51.     begin
  52.       writeln('Cannot open ',InpFileName,' for input. IOResult = ',Code);
  53.       halt;
  54.     end;
  55.   (* get pointers *)
  56.   AllocMemoryP := @AllocMemory;
  57.   FreeMemoryP  := @FreeMemory;
  58.   ReaderP := @Reader;
  59.   WriterP := @Writer;
  60.   (* Initialize LZW *)
  61.   Code :=  InitLZW(AllocMemoryP);
  62.   while TRUE do
  63.   begin
  64.     if KeyPressed then
  65.       begin
  66.         writeln;
  67.         writeln('Aborted by USER');
  68.         Halt;
  69.       end;
  70.     (* get filename from archive *)
  71.     OutFileName := '';
  72.     (* get 1st character, skipping any leading 0 *)
  73.     x := Reader;
  74.     if x = 0 then x := Reader;
  75.     repeat
  76.       if x = -1 then
  77.         begin
  78.           (* close input *)
  79.           Code := ReaderClose;
  80.           (* Terminate LZW *)
  81.           writeln(Count,' files recovered.');
  82.           Code := TermLZW(FreeMemoryP);
  83.           Halt;
  84.         end;
  85.       if x <> 0 then OutFileName := OutFileName + chr(x);
  86.       (* get next character from filename *)
  87.       x := Reader;
  88.     until x = 0;
  89.     (*writeln('<',OutFileName,'>');*)
  90.     Count := Count + 1;
  91.     (* open outut file *)
  92.     Code := WriterOpen(OutFileName);
  93.     if Code <> 0 then
  94.       begin
  95.         writeln('Cannot open ',OutFileName,' for output. IOResult = ',Code);
  96.         halt;
  97.       end;
  98.     (* expand *)
  99.     write('EXPANDING ',OutFileName:12,' ');
  100.     Code := Expand(ReaderP,WriterP);
  101.     if Code < 0 then
  102.       begin
  103.         SayError(Code);
  104.         Halt;
  105.       end;
  106.     writeln('OK');
  107.     (* close output file *)
  108.     Code := WriterClose;
  109.   end; (* while *)
  110. end.